/* ------------------- Mappable images processor -----------------------------*/
/* SREFILTR's "mappable" images processor.
.
. The bulk of this (the READMAP, GetURLfromMAP, and CrossingsMultiplyTest)
. was taken pretty much verbatim from the GOHTTP package:
. "GoHTTP REXX Filter Script for GoServe v2.00+ for OS/2
. by Donald L. Meyer
.
. A NSCA style MAP file is expected, which should contain
. instructions as to what regions of the image map to
. what urls. Four types of regions are recognized:
. circles, rectangles, polygons, points.
If the selected point falls within a circle, rectangle, or polygon,
. or it's exactly on a point, then we have a direct match. If this doesn't
. occur, and there are points selected, then it is assigned to the closest point,
. given that the distance to this closest point is less then max_pointdist (in pixel)
. If none of these satisfied, then use default_url.
*/
/* -------------------------------------------------------------*/
/* ----------------------------------------------------------------------- */
/* Main routine for processing mappable images respones */
/* ----------------------------------------------------------------------- */
sref_mapimage:
parse arg mapfile,awords, servername, serverport, tempfile, dir, max_pointdist
awords=packur(awords)
default_url=""
parse var awords ax ',' ay .
parse var ay ay '?' . /* get rid of accidentally added junk*/
if datatype(ax)<>"NUM" | datatype(ay)<>"NUM" then signal noxy
if datatype(max_pointdist)<>"NUM" then max_pointdist=50
/* check for mapfile, or mapfile.map */
aa=stream(mapfile,'c','query exists')
if aa="" & pos('.',mapfile)=0 then do /* add .map if non existent map file and no . */
mapfile=mapfile'.MAP'
end
ause=fileread(mapfile,'filelines',,'E')
doit=filelines.0
if doit=0 then signal nomap /* no such map file */
region.0=0
nr2=readmap() /* sets default_url and Region,
expects filelines. servername port */
if nr2=0 & default_url="" then signal nourl
say " Using mapfile: " mapfile " , # regions=" region.nregions
message=geturlfrommap(ax, ay)
if message="" then signal nomatch /* could not find a url */
message=sref_fix_url(message,servername,serverport)
/* we send back to the server a "redirect to this found url" response */
say " Moved to Url: " message
/* Send back resonse headers */
'RESPONSE HTTP/1.0 302 Moved Temporarily' /* Set HTTP response line */
'HEADER ADD URI: 'message
'HEADER ADD Location: 'message
doc = ''
'VAR TYPE text/html BINARY NAME doc'
return 1
say " Redirect to " message
/* error returns ... */
nourl: /* jump here if no such url found */
call lineout tempfile, ''
call lineout tempfile, " No such matching URL "
call lineout tempfile, ""
call lineout tempfile, "Could not find any URLS.
"
call lineout tempfile, ' No URLS were listed in the "map" file ' mapfile0
call lineout tempfile, ' '
say " Empty mapfile: " mapfile
'FILE ERASE TYPE text/html NAME '||tempfile
return 0
nomatch: /* jump here if no url found */
call lineout tempfile, ''
call lineout tempfile, " No URL selected "
call lineout tempfile, ""
call lineout tempfile, "A URL was not selected
"
call lineout tempfile, ' You selected a region NOT associated with a URL: ' ax ay
call lineout tempfile, ' '
say ' No URL match: ' ax ay mapfile
'FILE ERASE TYPE text/html NAME 'tempfile
return 0
nomap:
call lineout tempfile, ''
call lineout tempfile, " No such MAP file "
call lineout tempfile, ""
call lineout tempfile, "Could not find MAP file.
"
call lineout tempfile, ' The "map" file ' mapfile0 ' could not be found.'
call lineout tempfile, ' '
say ' No such mapfile: ' mapfile
'FILE ERASE TYPE text/html NAME 'tempfile
return 0
noxy: /* invalid x y */
call lineout tempfile, ''
call lineout tempfile, " Bad location "
call lineout tempfile, ""
call lineout tempfile, "Invalid pixel location given.
"
call lineout tempfile, ' The location given is invalid:' ax " , " ay
call lineout tempfile, ' '
say ' Bad x y: ' ax ay
'FILE ERASE TYPE text/html NAME 'tempfile
return 0
/* ----------------------------------------------------------------------- */
/* READMAP: Read in the .MAP file into a stem variable.
. The stem variable Region. gets filled up with "region" info.
. Also, the default_url gets set (if a DEFAULT line is found) */
/* ----------------------------------------------------------------------- */
readMap: procedure expose Region. Default_URL filelines. ServerName Port
/* Initilizations */
i = 0
nR = 0
strongchecks=1 /* always check for proper syntax */
Text = '%'
Default_URL = ''
/* read file into filelines. array */
/* read in the region definitions from the .MAP file. */
do jj=1 to filelines.0
text=strip(filelines.jj)
if text="" then iterate /* ignore blank lines */
if left(Text,1)= '#' then iterate /* # starts a comment line */
i = i + 1
parse var Text Text '#' comments /* trim any comments */
r = right(Text,1)
l = left(comments,1)
if (((r \= ' ') & (r \= '') & (r \= '09'x)) & ((l \= ' ') & (l \= '') & (l \= '09'x))) then do
parse var comments comments'#'rest /* trim any comments, again */
Text = Text'#'comments
end
parse var Text T Region.URL.i Cs
parse var Cs C1 C2
parse upper var T Region.Type.i
Err = 0
Select
/* DEFAULT keyword sets the default URL to redirect to in case of no region matches. */
When (Region.Type.i = 'DEFAULT') then do
Default_URL = Region.URL.i
i = i - 1
end
/* Parse out coordinates for the Rectangular region. */
When (Region.Type.i = 'RECT') then do
parse var C1 Region.X1.i ',' Region.Y1.i
parse var C2 Region.X2.i ',' Region.Y2.i
if (StrongChecks) then do
if ((Datatype(Region.X1.i) \= 'NUM') | (Datatype(Region.Y1.i) \= 'NUM') | (Datatype(Region.X2.i) \= 'NUM') | (Datatype(Region.Y2.i) \= 'NUM')) then Err = 1
end
if (Err == 0) then do
nR = nR + 1
/* ensure that X1,Y1 is upper left, and X2,Y2 is lower right... */
if (Region.X2.i < Region.X1.i) then /* Swap... */
do 1
a = Region.X2.i
Region.X2.i = Region.X1.i
Region.X1.i = a
end
if (Region.Y2.i < Region.Y1.i) then /* Swap... */
do
a = Region.Y2.i
Region.Y2.i = Region.Y1.i
Region.Y1.i = a
end
end
end
/* Parse out coordinates for the Circle region. */
When (Region.Type.i = 'CIRC') then do
parse var C1 Region.X1.i ',' Region.Y1.i
/* radius... */
Region.X2.i = C2
if (StrongChecks) then do
if ((Datatype(Region.X1.i) \= 'NUM') | (Datatype(Region.Y1.i) \= 'NUM') | (Datatype(Region.X2.i) \= 'NUM')) then Err = 1
end
if (Err == 0) then do
Region.radius2.i = (Region.X2.i**2)
nR = nR + 1
end
end
/* Parse out coordinates for the Circle region. */
When (Region.Type.i = 'CIRCLE') then do
parse var C1 Region.X1.i ',' Region.Y1.i
parse var C2 Region.X2.i ',' Region.Y2.i
if (StrongChecks) then do
if ((Datatype(Region.X1.i) \= 'NUM') | (Datatype(Region.Y1.i) \= 'NUM') | (Datatype(Region.X2.i) \= 'NUM') | (Datatype(Region.Y2.i) \= 'NUM')) then Err = 1
end
if (Err == 0) then do
/* radius... */
qX = (Region.X1.i - Region.X2.i)
qY = (Region.Y1.i - Region.Y2.i)
Region.radius2.i = (qX*qX) + (qY*qY)
nR = nR + 1
end
end
/* handle the Poly region. */
When (Region.Type.i = 'POLY') then do
k=1
do while (strip(Cs) \= '') & (Err == 0)
parse var Cs Region.X.i.k ',' Region.Y.i.k Cs
if (StrongChecks) then if ((Datatype(Region.X.i.k) \= 'NUM') | (Datatype(Region.Y.i.k) \= 'NUM')) then Err = 1
k = k + 1
end
if (Err == 0) then do
Region.NVerts.i = (k - 1)
Region.X.i.k = -1
nR = nR + 1
end
end
/* handle the Point region. */
When (Region.Type.i = 'POINT') then do
parse var C1 Region.X1.i ',' Region.Y1.i
if (StrongChecks) then do
if ((Datatype(Region.X1.i) \= 'NUM') | (Datatype(Region.Y1.i) \= 'NUM')) then Err = 1
end
if (Err == 0) then nR = nR + 1
end
/* handle the standard blank line between 'Default' line and other regions... */
When (Region.Type.i = '') then do
if ((i = 1) & (Default_URL \= '')) then do
Text = '%'
i = i - 1
end
end
/* Must be an unknown region type... */
Otherwise do
if (Text \= '') then
say 'Unknown RegionType=['Region.Type.i'] URL=<'Region.URL.i'> [C1='C1' C2='C2']'
i = i - 1
end
end /* Select */
if (Err == 1) then say 'error: region #'i
if (Err == 1) then i = i - 1
end
rc = stream(Map.filename.ID, 'C', 'CLOSE')
Region.NRegions = nR
return nR
/* ----------------------------------------------------------------------- */
/* GetURLfromMap: Identify the region of the map, & return the associated URL */
/* ----------------------------------------------------------------------- */
GetURLfromMap: procedure expose Region. Default_URL max_pointdist
/* Parse out mouse click coordinates */
parse arg tX , tY
i = 1; Hit = 0; sawpoint = 0
/* Set URL to the default, in case no regions are hit... */
_URL = Default_URL
/* if tX & tY = '', then assume web client not imagemap capable - bypass region search. */
if (tX='') then Hit = -1
/* Loop through the defined regions to find first hit. */
do while ((i <= Region.NRegions) & (Hit = 0))
Select
/* Determine if coordinates lie within the rectangular area. */
When Region.Type.i = 'RECT' then do
Hit = ((tX >= Region.X1.i) & (tY >= Region.Y1.i) & (tX <= Region.X2.i) & (tY <= Region.Y2.i))
end
/* Calc distance to coordinates from Circle center, and compare to radius.*/
/* If less than radius, then it's a hit... */
When (Region.Type.i = 'CIRC') | (Region.Type.i = 'CIRCLE') then do
a = tX - Region.X1.i
b = tY - Region.Y1.i
R = a**2 + b**2
Hit = (R <= Region.radius2.i)
end
/* Determine if coordinates lie within the polygon. */
When Region.Type.i = 'POLY' then do
Hit = CrossingsMultiplyTest(i, tX, tY)
end
When Region.Type.i = 'POINT' then do
a = tX - Region.X1.i
b = tY - Region.Y1.i
R = (a * a) + (b * b)
/* If a direct hit, then don't bother with nearest determinations... */
if (R == 0) then Hit = 1
/* otherwise, track to find which point is nearest the click coordinates... */
else if (sawpoint) then do
if (R < PointDistance) then do
PointDistance = R
ClosestPoint = i
end
end
else do
sawpoint = 1
PointDistance = R
ClosestPoint = i
end
end
/* The required 'Otherwise'... */
Otherwise do
end
End /* Select */
/* If a hit, then set '_URL' to stem URL value. */
if (Hit = 1) then do
_URL = Region.URL.i
end
i = i + 1
end
if (Hit == 0) & (sawpoint) & (pointdistance < (max_pointdist*max_pointdist)) then do
_URL = Region.URL.ClosestPoint
end
return _URL /* return the identified URL */
/* ----------------------------------------------------------------------- */
/* ======= Crossings Multiply algorithm ===================================
. point in polygon inside/outside code.
. Original C code by Eric Haines, 3D/Eye Inc, erich@eye.com
. based on work by Joseph Samosky and Mark Haigh-Hutchinson.
. Ported to REXX for this filter by D.L. Meyer, meyer@larch.ag.uiuc.edu
*/
/* ----------------------------------------------------------------------- */
CrossingsMultiplyTest: Procedure expose Region.
parse arg pgon, pointX, pointY
numverts = Region.NVerts.pgon
vtx0X = Region.X.pgon.numverts
vtx0Y = Region.Y.pgon.numverts
/* get test bit for above/below X axis */
yflag0 = ( vtx0Y >= pointY )
inside_flag = 0
do j = 1 to numverts
vtx1X = Region.X.pgon.j
vtx1Y = Region.Y.pgon.j
yflag1 = ( vtx1Y >= pointY )
/* Check if endpoints straddle (are on opposite sides) of X axis
* (i.e. the Y's differ); if so, +X ray could intersect this edge.
* The old test also checked whether the endpoints are both to the
* right or to the left of the test point. However, given the faster
* intersection point computation used below, this test was found to
* be a break-even proposition for most polygons and a loser for
* triangles (where 50% or more of the edges which survive this test
* will cross quadrants and so have to have the X intersection computed
* anyway). I credit Joseph Samosky with inspiring me to try dropping
* the "both left or both right" part of my code.
*/
if ( yflag0 \= yflag1 ) then do
/* Check intersection of pgon segment with +X ray.
* Note if >= point's X; if so, the ray hits it.
* The division operation is avoided for the ">=" test by checking
* the sign of the first vertex wrto the test point; idea inspired
* by Joseph Samosky's and Mark Haigh-Hutchinson's different
* polygon inclusion tests.
*/
if ( (((vtx1Y-pointY) * (vtx0X-vtx1X)) >= ((vtx1X-pointX) * (vtx0Y-vtx1Y))) == yflag1 ) then do
inside_flag = (inside_flag == 0)
end
end
/* Move to the next pair of vertices, retaining info as possible. */
yflag0 = yflag1
vtx0X = vtx1X
vtx0Y = vtx1Y
end
return inside_flag